home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 008a / perl40_2.zip / PERLY.Y < prev    next >
Text File  |  1991-11-28  |  23KB  |  872 lines
  1. /* $RCSfile: perly.y,v $$Revision: 4.0.1.2 $$Date: 91/11/05 18:17:38 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    perly.y,v $
  9.  * Revision 4.0.1.2  91/11/05  18:17:38  lwall
  10.  * patch11: extra comma at end of list is now allowed in more places (Hi, Felix!)
  11.  * patch11: once-thru blocks didn't display right in the debugger
  12.  * patch11: debugger got confused over nested subroutine definitions
  13.  *
  14.  * Revision 4.0.1.1  91/06/07  11:42:34  lwall
  15.  * patch4: new copyright notice
  16.  *
  17.  * Revision 4.0  91/03/20  01:38:40  lwall
  18.  * 4.0 baseline.
  19.  *
  20.  */
  21.  
  22.  
  23. %{
  24. #include "INTERN.h"
  25. #include "perl.h"
  26.  
  27.  
  28. /*SUPPRESS 530*/
  29. /*SUPPRESS 593*/
  30. /*SUPPRESS 595*/
  31.  
  32.  
  33. STAB *scrstab;
  34. ARG *arg4;    /* rarely used arguments to make_op() */
  35. ARG *arg5;
  36.  
  37.  
  38. %}
  39.  
  40.  
  41. %start prog
  42.  
  43.  
  44. %union {
  45.     int    ival;
  46.     char *cval;
  47.     ARG *arg;
  48.     CMD *cmdval;
  49.     struct compcmd compval;
  50.     STAB *stabval;
  51.     FCMD *formval;
  52. }
  53.  
  54.  
  55. %token <ival> '{' ')'
  56.  
  57.  
  58. %token <cval> WORD
  59. %token <ival> APPEND OPEN SSELECT LOOPEX
  60. %token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN
  61. %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST
  62. %token <ival> FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25
  63. %token <ival> FUNC0 FUNC1 FUNC2 FUNC2x FUNC3 FUNC4 FUNC5 HSHFUN HSHFUN3
  64. %token <ival> FLIST2 SUB FILETEST LOCAL DELETE
  65. %token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER
  66. %token <formval> FORMLIST
  67. %token <stabval> REG ARYLEN ARY HSH STAR
  68. %token <arg> SUBST PATTERN
  69. %token <arg> RSTRING TRANS
  70.  
  71.  
  72. %type <ival> prog decl format remember crp
  73. %type <cmdval> block lineseq line loop cond sideff nexpr else
  74. %type <arg> expr sexpr cexpr csexpr term handle aryword hshword
  75. %type <arg> texpr listop bareword
  76. %type <cval> label
  77. %type <compval> compblock
  78.  
  79.  
  80. %nonassoc <ival> LISTOP
  81. %left ','
  82. %right '='
  83. %right '?' ':'
  84. %nonassoc DOTDOT
  85. %left OROR
  86. %left ANDAND
  87. %left '|' '^'
  88. %left '&'
  89. %nonassoc EQOP
  90. %nonassoc RELOP
  91. %nonassoc <ival> UNIOP
  92. %nonassoc FILETEST
  93. %left LS RS
  94. %left ADDOP
  95. %left MULOP
  96. %left MATCH NMATCH
  97. %right '!' '~' UMINUS
  98. %right POW
  99. %nonassoc INC DEC
  100. %left '('
  101.  
  102.  
  103. %% /* RULES */
  104.  
  105.  
  106. prog    :    /* NULL */
  107.         {
  108. #if defined(YYDEBUG) && defined(DEBUGGING)
  109.             yydebug = (debug & 1);
  110. #endif
  111.         }
  112.     /*CONTINUED*/    lineseq
  113.             { if (in_eval)
  114.                 eval_root = block_head($2);
  115.                 else
  116.                 main_root = block_head($2); }
  117.     ;
  118.  
  119.  
  120. compblock:    block CONTINUE block
  121.             { $$.comp_true = $1; $$.comp_alt = $3; }
  122.     |    block else
  123.             { $$.comp_true = $1; $$.comp_alt = $2; }
  124.     ;
  125.  
  126.  
  127. else    :    /* NULL */
  128.             { $$ = Nullcmd; }
  129.     |    ELSE block
  130.             { $$ = $2; }
  131.     |    ELSIF '(' expr ')' compblock
  132.             { cmdline = $1;
  133.                 $$ = make_ccmd(C_ELSIF,$3,$5); }
  134.     ;
  135.  
  136.  
  137. block    :    '{' remember lineseq '}'
  138.             { $$ = block_head($3);
  139.               if (cmdline > $1)
  140.                   cmdline = $1;
  141.               if (savestack->ary_fill > $2)
  142.                 restorelist($2); }
  143.     ;
  144.  
  145.  
  146. remember:    /* NULL */    /* in case they push a package name */
  147.             { $$ = savestack->ary_fill; }
  148.     ;
  149.  
  150.  
  151. lineseq    :    /* NULL */
  152.             { $$ = Nullcmd; }
  153.     |    lineseq line
  154.             { $$ = append_line($1,$2); }
  155.     ;
  156.  
  157.  
  158. line    :    decl
  159.             { $$ = Nullcmd; }
  160.     |    label cond
  161.             { $$ = add_label($1,$2); }
  162.     |    loop    /* loops add their own labels */
  163.     |    label ';'
  164.             { if ($1 != Nullch) {
  165.                   $$ = add_label($1, make_acmd(C_EXPR, Nullstab,
  166.                   Nullarg, Nullarg) );
  167.                 }
  168.                 else {
  169.                   $$ = Nullcmd;
  170.                   cmdline = NOLINE;
  171.                 } }
  172.     |    label sideff ';'
  173.             { $$ = add_label($1,$2); }
  174.     ;
  175.  
  176.  
  177. sideff    :    error
  178.             { $$ = Nullcmd; }
  179.     |    expr
  180.             { $$ = make_acmd(C_EXPR, Nullstab, $1, Nullarg); }
  181.     |    expr IF expr
  182.             { $$ = addcond(
  183.                    make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
  184.     |    expr UNLESS expr
  185.             { $$ = addcond(invert(
  186.                    make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
  187.     |    expr WHILE expr
  188.             { $$ = addloop(
  189.                    make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
  190.     |    expr UNTIL expr
  191.             { $$ = addloop(invert(
  192.                    make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
  193.     ;
  194.  
  195.  
  196. cond    :    IF '(' expr ')' compblock
  197.             { cmdline = $1;
  198.                 $$ = make_icmd(C_IF,$3,$5); }
  199.     |    UNLESS '(' expr ')' compblock
  200.             { cmdline = $1;
  201.                 $$ = invert(make_icmd(C_IF,$3,$5)); }
  202.     |    IF block compblock
  203.             { cmdline = $1;
  204.                 $$ = make_ccmd(C_IF,cmd_to_arg($2),$3); }
  205.     |    UNLESS block compblock
  206.             { cmdline = $1;
  207.                 $$ = invert(make_ccmd(C_IF,cmd_to_arg($2),$3)); }
  208.     ;
  209.  
  210.  
  211. loop    :    label WHILE '(' texpr ')' compblock
  212.             { cmdline = $2;
  213.                 $$ = wopt(add_label($1,
  214.                 make_ccmd(C_WHILE,$4,$6) )); }
  215.     |    label UNTIL '(' expr ')' compblock
  216.             { cmdline = $2;
  217.                 $$ = wopt(add_label($1,
  218.                 invert(make_ccmd(C_WHILE,$4,$6)) )); }
  219.     |    label WHILE block compblock
  220.             { cmdline = $2;
  221.                 $$ = wopt(add_label($1,
  222.                 make_ccmd(C_WHILE, cmd_to_arg($3),$4) )); }
  223.     |    label UNTIL block compblock
  224.             { cmdline = $2;
  225.                 $$ = wopt(add_label($1,
  226.                 invert(make_ccmd(C_WHILE, cmd_to_arg($3),$4)) )); }
  227.     |    label FOR REG '(' expr crp compblock
  228.             { cmdline = $2;
  229.                 /*
  230.                  * The following gobbledygook catches EXPRs that
  231.                  * aren't explicit array refs and translates
  232.                  *        foreach VAR (EXPR) {
  233.                  * into
  234.                  *        @ary = EXPR;
  235.                  *        foreach VAR (@ary) {
  236.                  * where @ary is a hidden array made by genstab().
  237.                  * (Note that @ary may become a local array if
  238.                  * it is determined that it might be called
  239.                  * recursively.  See cmd_tosave().)
  240.                  */
  241.                 if ($5->arg_type != O_ARRAY) {
  242.                 scrstab = aadd(genstab());
  243.                 $$ = append_line(
  244.                     make_acmd(C_EXPR, Nullstab,
  245.                       l(make_op(O_ASSIGN,2,
  246.                     listish(make_op(O_ARRAY, 1,
  247.                       stab2arg(A_STAB,scrstab),
  248.                       Nullarg,Nullarg )),
  249.                     listish(make_list($5)),
  250.                     Nullarg)),
  251.                       Nullarg),
  252.                     wopt(over($3,add_label($1,
  253.                       make_ccmd(C_WHILE,
  254.                     make_op(O_ARRAY, 1,
  255.                       stab2arg(A_STAB,scrstab),
  256.                       Nullarg,Nullarg ),
  257.                     $7)))));
  258.                 $$->c_line = $2;
  259.                 $$->c_head->c_line = $2;
  260.                 }
  261.                 else {
  262.                 $$ = wopt(over($3,add_label($1,
  263.                 make_ccmd(C_WHILE,$5,$7) )));
  264.                 }
  265.             }
  266.     |    label FOR '(' expr crp compblock
  267.             { cmdline = $2;
  268.                 if ($4->arg_type != O_ARRAY) {
  269.                 scrstab = aadd(genstab());
  270.                 $$ = append_line(
  271.                     make_acmd(C_EXPR, Nullstab,
  272.                       l(make_op(O_ASSIGN,2,
  273.                     listish(make_op(O_ARRAY, 1,
  274.                       stab2arg(A_STAB,scrstab),
  275.                       Nullarg,Nullarg )),
  276.                     listish(make_list($4)),
  277.                     Nullarg)),
  278.                       Nullarg),
  279.                     wopt(over(defstab,add_label($1,
  280.                       make_ccmd(C_WHILE,
  281.                     make_op(O_ARRAY, 1,
  282.                       stab2arg(A_STAB,scrstab),
  283.                       Nullarg,Nullarg ),
  284.                     $6)))));
  285.                 $$->c_line = $2;
  286.                 $$->c_head->c_line = $2;
  287.                 }
  288.                 else {    /* lisp, anyone? */
  289.                 $$ = wopt(over(defstab,add_label($1,
  290.                 make_ccmd(C_WHILE,$4,$6) )));
  291.                 }
  292.             }
  293.     |    label FOR '(' nexpr ';' texpr ';' nexpr ')' block
  294.             /* basically fake up an initialize-while lineseq */
  295.             {   yyval.compval.comp_true = $10;
  296.                 yyval.compval.comp_alt = $8;
  297.                 cmdline = $2;
  298.                 $$ = append_line($4,wopt(add_label($1,
  299.                 make_ccmd(C_WHILE,$6,yyval.compval) ))); }
  300.     |    label compblock    /* a block is a loop that happens once */
  301.             { $$ = add_label($1,make_ccmd(C_BLOCK,Nullarg,$2)); }
  302.     ;
  303.  
  304.  
  305. nexpr    :    /* NULL */
  306.             { $$ = Nullcmd; }
  307.     |    sideff
  308.     ;
  309.  
  310.  
  311. texpr    :    /* NULL means true */
  312.             { (void)scanstr("1"); $$ = yylval.arg; }
  313.     |    expr
  314.     ;
  315.  
  316.  
  317. label    :    /* empty */
  318.             { $$ = Nullch; }
  319.     |    WORD ':'
  320.     ;
  321.  
  322.  
  323. decl    :    format
  324.             { $$ = 0; }
  325.     |    subrout
  326.             { $$ = 0; }
  327.     |    package
  328.             { $$ = 0; }
  329.     ;
  330.  
  331.  
  332. format    :    FORMAT WORD '=' FORMLIST
  333.             { if (strEQ($2,"stdout"))
  334.                 make_form(stabent("STDOUT",TRUE),$4);
  335.               else if (strEQ($2,"stderr"))
  336.                 make_form(stabent("STDERR",TRUE),$4);
  337.               else
  338.                 make_form(stabent($2,TRUE),$4);
  339.               Safefree($2); $2 = Nullch; }
  340.     |    FORMAT '=' FORMLIST
  341.             { make_form(stabent("STDOUT",TRUE),$3); }
  342.     ;
  343.  
  344.  
  345. subrout    :    SUB WORD block
  346.             { make_sub($2,$3);
  347.               cmdline = NOLINE;
  348.               if (savestack->ary_fill > $1)
  349.                 restorelist($1); }
  350.     ;
  351.  
  352.  
  353. package :    PACKAGE WORD ';'
  354.             { char tmpbuf[256];
  355.               STAB *tmpstab;
  356.  
  357.  
  358.               savehptr(&curstash);
  359.               saveitem(curstname);
  360.               str_set(curstname,$2);
  361.               sprintf(tmpbuf,"'_%s",$2);
  362.               tmpstab = stabent(tmpbuf,TRUE);
  363.               if (!stab_xhash(tmpstab))
  364.                   stab_xhash(tmpstab) = hnew(0);
  365.               curstash = stab_xhash(tmpstab);
  366.               if (!curstash->tbl_name)
  367.                   curstash->tbl_name = savestr($2);
  368.               curstash->tbl_coeffsize = 0;
  369.               Safefree($2); $2 = Nullch;
  370.               cmdline = NOLINE;
  371.             }
  372.     ;
  373.  
  374.  
  375. cexpr    :    ',' expr
  376.             { $$ = $2; }
  377.     ;
  378.  
  379.  
  380. expr    :    expr ',' sexpr
  381.             { $$ = make_op(O_COMMA, 2, $1, $3, Nullarg); }
  382.     |    sexpr
  383.     ;
  384.  
  385.  
  386. csexpr    :    ',' sexpr
  387.             { $$ = $2; }
  388.     ;
  389.  
  390.  
  391. sexpr    :    sexpr '=' sexpr
  392.             {   $1 = listish($1);
  393.                 if ($1->arg_type == O_ASSIGN && $1->arg_len == 1)
  394.                 $1->arg_type = O_ITEM;    /* a local() */
  395.                 if ($1->arg_type == O_LIST)
  396.                 $3 = listish($3);
  397.                 $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg)); }
  398.     |    sexpr POW '=' sexpr
  399.             { $$ = l(make_op(O_POW, 2, $1, $4, Nullarg)); }
  400.     |    sexpr MULOP '=' sexpr
  401.             { $$ = l(make_op($2, 2, $1, $4, Nullarg)); }
  402.     |    sexpr ADDOP '=' sexpr
  403.             { $$ = rcatmaybe(l(make_op($2, 2, $1, $4, Nullarg)));}
  404.     |    sexpr LS '=' sexpr
  405.             { $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg)); }
  406.     |    sexpr RS '=' sexpr
  407.             { $$ = l(make_op(O_RIGHT_SHIFT, 2, $1, $4, Nullarg)); }
  408.     |    sexpr '&' '=' sexpr
  409.             { $$ = l(make_op(O_BIT_AND, 2, $1, $4, Nullarg)); }
  410.     |    sexpr '^' '=' sexpr
  411.             { $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg)); }
  412.     |    sexpr '|' '=' sexpr
  413.             { $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg)); }
  414.  
  415.  
  416.  
  417.  
  418.     |    sexpr POW sexpr
  419.             { $$ = make_op(O_POW, 2, $1, $3, Nullarg); }
  420.     |    sexpr MULOP sexpr
  421.             { if ($2 == O_REPEAT)
  422.                   $1 = listish($1);
  423.                 $$ = make_op($2, 2, $1, $3, Nullarg);
  424.                 if ($2 == O_REPEAT) {
  425.                 if ($$[1].arg_type != A_EXPR ||
  426.                   $$[1].arg_ptr.arg_arg->arg_type != O_LIST)
  427.                     $$[1].arg_flags &= ~AF_ARYOK;
  428.                 } }
  429.     |    sexpr ADDOP sexpr
  430.             { $$ = make_op($2, 2, $1, $3, Nullarg); }
  431.     |    sexpr LS sexpr
  432.             { $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg); }
  433.     |    sexpr RS sexpr
  434.             { $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg); }
  435.     |    sexpr RELOP sexpr
  436.             { $$ = make_op($2, 2, $1, $3, Nullarg); }
  437.     |    sexpr EQOP sexpr
  438.             { $$ = make_op($2, 2, $1, $3, Nullarg); }
  439.     |    sexpr '&' sexpr
  440.             { $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg); }
  441.     |    sexpr '^' sexpr
  442.             { $$ = make_op(O_XOR, 2, $1, $3, Nullarg); }
  443.     |    sexpr '|' sexpr
  444.             { $$ = make_op(O_BIT_OR, 2, $1, $3, Nullarg); }
  445.     |    sexpr DOTDOT sexpr
  446.             { arg4 = Nullarg;
  447.               $$ = make_op(O_F_OR_R, 4, $1, $3, Nullarg); }
  448.     |    sexpr ANDAND sexpr
  449.             { $$ = make_op(O_AND, 2, $1, $3, Nullarg); }
  450.     |    sexpr OROR sexpr
  451.             { $$ = make_op(O_OR, 2, $1, $3, Nullarg); }
  452.     |    sexpr '?' sexpr ':' sexpr
  453.             { $$ = make_op(O_COND_EXPR, 3, $1, $3, $5); }
  454.     |    sexpr MATCH sexpr
  455.             { $$ = mod_match(O_MATCH, $1, $3); }
  456.     |    sexpr NMATCH sexpr
  457.             { $$ = mod_match(O_NMATCH, $1, $3); }
  458.     |    term
  459.             { $$ = $1; }
  460.     ;
  461.  
  462.  
  463. term    :    '-' term %prec UMINUS
  464.             { $$ = make_op(O_NEGATE, 1, $2, Nullarg, Nullarg); }
  465.     |    '+' term %prec UMINUS
  466.             { $$ = $2; }
  467.     |    '!' term
  468.             { $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg); }
  469.     |    '~' term
  470.             { $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg);}
  471.     |    term INC
  472.             { $$ = addflags(1, AF_POST|AF_UP,
  473.                 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
  474.     |    term DEC
  475.             { $$ = addflags(1, AF_POST,
  476.                 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
  477.     |    INC term
  478.             { $$ = addflags(1, AF_PRE|AF_UP,
  479.                 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
  480.     |    DEC term
  481.             { $$ = addflags(1, AF_PRE,
  482.                 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
  483.     |    FILETEST WORD
  484.             { opargs[$1] = 0;    /* force it special */
  485.                 $$ = make_op($1, 1,
  486.                 stab2arg(A_STAB,stabent($2,TRUE)),
  487.                 Nullarg, Nullarg);
  488.             }
  489.     |    FILETEST sexpr
  490.             { opargs[$1] = 1;
  491.                 $$ = make_op($1, 1, $2, Nullarg, Nullarg); }
  492.     |    FILETEST
  493.             { opargs[$1] = ($1 != O_FTTTY);
  494.                 $$ = make_op($1, 1,
  495.                 stab2arg(A_STAB,
  496.                   $1 == O_FTTTY?stabent("STDIN",TRUE):defstab),
  497.                 Nullarg, Nullarg); }
  498.     |    LOCAL '(' expr crp
  499.             { $$ = l(localize(make_op(O_ASSIGN, 1,
  500.                 localize(listish(make_list($3))),
  501.                 Nullarg,Nullarg))); }
  502.     |    '(' expr crp
  503.             { $$ = make_list($2); }
  504.     |    '(' ')'
  505.             { $$ = make_list(Nullarg); }
  506.     |    DO sexpr    %prec FILETEST
  507.             { $$ = make_op(O_DOFILE,2,$2,Nullarg,Nullarg);
  508.               allstabs = TRUE;}
  509.     |    DO block    %prec '('
  510.             { $$ = cmd_to_arg($2); }
  511.     |    REG    %prec '('
  512.             { $$ = stab2arg(A_STAB,$1); }
  513.     |    STAR    %prec '('
  514.             { $$ = stab2arg(A_STAR,$1); }
  515.     |    REG '[' expr ']'    %prec '('
  516.             { $$ = make_op(O_AELEM, 2,
  517.                 stab2arg(A_STAB,aadd($1)), $3, Nullarg); }
  518.     |    HSH     %prec '('
  519.             { $$ = make_op(O_HASH, 1,
  520.                 stab2arg(A_STAB,$1),
  521.                 Nullarg, Nullarg); }
  522.     |    ARY     %prec '('
  523.             { $$ = make_op(O_ARRAY, 1,
  524.                 stab2arg(A_STAB,$1),
  525.                 Nullarg, Nullarg); }
  526.     |    REG '{' expr '}'    %prec '('
  527.             { $$ = make_op(O_HELEM, 2,
  528.                 stab2arg(A_STAB,hadd($1)),
  529.                 jmaybe($3),
  530.                 Nullarg); }
  531.     |    '(' expr crp '[' expr ']'    %prec '('
  532.             { $$ = make_op(O_LSLICE, 3,
  533.                 Nullarg,
  534.                 listish(make_list($5)),
  535.                 listish(make_list($2))); }
  536.     |    '(' ')' '[' expr ']'    %prec '('
  537.             { $$ = make_op(O_LSLICE, 3,
  538.                 Nullarg,
  539.                 listish(make_list($4)),
  540.                 Nullarg); }
  541.     |    ARY '[' expr ']'    %prec '('
  542.             { $$ = make_op(O_ASLICE, 2,
  543.                 stab2arg(A_STAB,aadd($1)),
  544.                 listish(make_list($3)),
  545.                 Nullarg); }
  546.     |    ARY '{' expr '}'    %prec '('
  547.             { $$ = make_op(O_HSLICE, 2,
  548.                 stab2arg(A_STAB,hadd($1)),
  549.                 listish(make_list($3)),
  550.                 Nullarg); }
  551.     |    DELETE REG '{' expr '}'    %prec '('
  552.             { $$ = make_op(O_DELETE, 2,
  553.                 stab2arg(A_STAB,hadd($2)),
  554.                 jmaybe($4),
  555.                 Nullarg); }
  556.     |    ARYLEN    %prec '('
  557.             { $$ = stab2arg(A_ARYLEN,$1); }
  558.     |    RSTRING    %prec '('
  559.             { $$ = $1; }
  560.     |    PATTERN    %prec '('
  561.             { $$ = $1; }
  562.     |    SUBST    %prec '('
  563.             { $$ = $1; }
  564.     |    TRANS    %prec '('
  565.             { $$ = $1; }
  566.     |    DO WORD '(' expr crp
  567.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  568.                 stab2arg(A_WORD,stabent($2,MULTI)),
  569.                 make_list($4),
  570.                 Nullarg); Safefree($2); $2 = Nullch;
  571.                 $$->arg_flags |= AF_DEPR; }
  572.     |    AMPER WORD '(' expr crp
  573.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  574.                 stab2arg(A_WORD,stabent($2,MULTI)),
  575.                 make_list($4),
  576.                 Nullarg); Safefree($2); $2 = Nullch; }
  577.     |    DO WORD '(' ')'
  578.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  579.                 stab2arg(A_WORD,stabent($2,MULTI)),
  580.                 make_list(Nullarg),
  581.                 Nullarg);
  582.                 $$->arg_flags |= AF_DEPR; }
  583.     |    AMPER WORD '(' ')'
  584.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  585.                 stab2arg(A_WORD,stabent($2,MULTI)),
  586.                 make_list(Nullarg),
  587.                 Nullarg); }
  588.     |    AMPER WORD
  589.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  590.                 stab2arg(A_WORD,stabent($2,MULTI)),
  591.                 Nullarg,
  592.                 Nullarg); }
  593.     |    DO REG '(' expr crp
  594.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  595.                 stab2arg(A_STAB,$2),
  596.                 make_list($4),
  597.                 Nullarg);
  598.                 $$->arg_flags |= AF_DEPR; }
  599.     |    AMPER REG '(' expr crp
  600.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  601.                 stab2arg(A_STAB,$2),
  602.                 make_list($4),
  603.                 Nullarg); }
  604.     |    DO REG '(' ')'
  605.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  606.                 stab2arg(A_STAB,$2),
  607.                 make_list(Nullarg),
  608.                 Nullarg);
  609.                 $$->arg_flags |= AF_DEPR; }
  610.     |    AMPER REG '(' ')'
  611.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  612.                 stab2arg(A_STAB,$2),
  613.                 make_list(Nullarg),
  614.                 Nullarg); }
  615.     |    AMPER REG
  616.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  617.                 stab2arg(A_STAB,$2),
  618.                 Nullarg,
  619.                 Nullarg); }
  620.     |    LOOPEX
  621.             { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
  622.     |    LOOPEX WORD
  623.             { $$ = make_op($1,1,cval_to_arg($2),
  624.                 Nullarg,Nullarg); }
  625.     |    UNIOP
  626.             { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
  627.     |    UNIOP block
  628.             { $$ = make_op($1,1,cmd_to_arg($2),Nullarg,Nullarg); }
  629.     |    UNIOP sexpr
  630.             { $$ = make_op($1,1,$2,Nullarg,Nullarg); }
  631.     |    SSELECT
  632.             { $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
  633.     |    SSELECT  WORD
  634.             { $$ = make_op(O_SELECT, 1,
  635.                 stab2arg(A_WORD,stabent($2,TRUE)),
  636.                 Nullarg,
  637.                 Nullarg);
  638.                 Safefree($2); $2 = Nullch; }
  639.     |    SSELECT '(' handle ')'
  640.             { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg); }
  641.     |    SSELECT '(' sexpr csexpr csexpr csexpr ')'
  642.             { arg4 = $6;
  643.               $$ = make_op(O_SSELECT, 4, $3, $4, $5); }
  644.     |    OPEN WORD    %prec '('
  645.             { $$ = make_op(O_OPEN, 2,
  646.                 stab2arg(A_WORD,stabent($2,TRUE)),
  647.                 stab2arg(A_STAB,stabent($2,TRUE)),
  648.                 Nullarg); }
  649.     |    OPEN '(' WORD ')'
  650.             { $$ = make_op(O_OPEN, 2,
  651.                 stab2arg(A_WORD,stabent($3,TRUE)),
  652.                 stab2arg(A_STAB,stabent($3,TRUE)),
  653.                 Nullarg); }
  654.     |    OPEN '(' handle cexpr ')'
  655.             { $$ = make_op(O_OPEN, 2,
  656.                 $3,
  657.                 $4, Nullarg); }
  658.     |    FILOP '(' handle ')'
  659.             { $$ = make_op($1, 1,
  660.                 $3,
  661.                 Nullarg, Nullarg); }
  662.     |    FILOP WORD
  663.             { $$ = make_op($1, 1,
  664.                 stab2arg(A_WORD,stabent($2,TRUE)),
  665.                 Nullarg, Nullarg);
  666.               Safefree($2); $2 = Nullch; }
  667.     |    FILOP REG
  668.             { $$ = make_op($1, 1,
  669.                 stab2arg(A_STAB,$2),
  670.                 Nullarg, Nullarg); }
  671.     |    FILOP '(' ')'
  672.             { $$ = make_op($1, 1,
  673.                 stab2arg(A_WORD,Nullstab),
  674.                 Nullarg, Nullarg); }
  675.     |    FILOP    %prec '('
  676.             { $$ = make_op($1, 0,
  677.                 Nullarg, Nullarg, Nullarg); }
  678.     |    FILOP2 '(' handle cexpr ')'
  679.             { $$ = make_op($1, 2, $3, $4, Nullarg); }
  680.     |    FILOP3 '(' handle csexpr cexpr ')'
  681.             { $$ = make_op($1, 3, $3, $4, make_list($5)); }
  682.     |    FILOP22 '(' handle ',' handle ')'
  683.             { $$ = make_op($1, 2, $3, $5, Nullarg); }
  684.     |    FILOP4 '(' handle csexpr csexpr cexpr ')'
  685.             { arg4 = $6; $$ = make_op($1, 4, $3, $4, $5); }
  686.     |    FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')'
  687.             { arg4 = $7; arg5 = $8;
  688.               $$ = make_op($1, 5, $3, $5, $6); }
  689.     |    PUSH '(' aryword ',' expr crp
  690.             { $$ = make_op($1, 2,
  691.                 $3,
  692.                 make_list($5),
  693.                 Nullarg); }
  694.     |    POP aryword    %prec '('
  695.             { $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); }
  696.     |    POP '(' aryword ')'
  697.             { $$ = make_op(O_POP, 1, $3, Nullarg, Nullarg); }
  698.     |    SHIFT aryword    %prec '('
  699.             { $$ = make_op(O_SHIFT, 1, $2, Nullarg, Nullarg); }
  700.     |    SHIFT '(' aryword ')'
  701.             { $$ = make_op(O_SHIFT, 1, $3, Nullarg, Nullarg); }
  702.     |    SHIFT    %prec '('
  703.             { $$ = make_op(O_SHIFT, 1,
  704.                 stab2arg(A_STAB,
  705.                   aadd(stabent(subline ? "_" : "ARGV", TRUE))),
  706.                 Nullarg, Nullarg); }
  707.     |    SPLIT    %prec '('
  708.             {   static char p[]="/\\s+/";
  709.                 char *oldend = bufend;
  710.                 ARG *oldarg = yylval.arg;
  711.     
  712.                 bufend=p+5;
  713.                 (void)scanpat(p);
  714.                 bufend=oldend;
  715.                 $$ = make_split(defstab,yylval.arg,Nullarg);
  716.                 yylval.arg = oldarg; }
  717.     |    SPLIT '(' sexpr csexpr csexpr ')'
  718.             { $$ = mod_match(O_MATCH, $4,
  719.               make_split(defstab,$3,$5));}
  720.     |    SPLIT '(' sexpr csexpr ')'
  721.             { $$ = mod_match(O_MATCH, $4,
  722.               make_split(defstab,$3,Nullarg) ); }
  723.     |    SPLIT '(' sexpr ')'
  724.             { $$ = mod_match(O_MATCH,
  725.                 stab2arg(A_STAB,defstab),
  726.                 make_split(defstab,$3,Nullarg) ); }
  727.     |    FLIST2 '(' sexpr cexpr ')'
  728.             { $$ = make_op($1, 2,
  729.                 $3,
  730.                 listish(make_list($4)),
  731.                 Nullarg); }
  732.     |    FLIST '(' expr crp
  733.             { $$ = make_op($1, 1,
  734.                 make_list($3),
  735.                 Nullarg,
  736.                 Nullarg); }
  737.     |    LVALFUN sexpr    %prec '('
  738.             { $$ = l(make_op($1, 1, fixl($1,$2),
  739.                 Nullarg, Nullarg)); }
  740.     |    LVALFUN
  741.             { $$ = l(make_op($1, 1,
  742.                 stab2arg(A_STAB,defstab),
  743.                 Nullarg, Nullarg)); }
  744.     |    FUNC0
  745.             { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
  746.     |    FUNC0 '(' ')'
  747.             { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
  748.     |    FUNC1 '(' ')'
  749.             { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
  750.     |    FUNC1 '(' expr ')'
  751.             { $$ = make_op($1, 1, $3, Nullarg, Nullarg); }
  752.     |    FUNC2 '(' sexpr cexpr ')'
  753.             { $$ = make_op($1, 2, $3, $4, Nullarg);
  754.                 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
  755.                 fbmcompile($$[2].arg_ptr.arg_str,0); }
  756.     |    FUNC2x '(' sexpr csexpr ')'
  757.             { $$ = make_op($1, 2, $3, $4, Nullarg);
  758.                 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
  759.                 fbmcompile($$[2].arg_ptr.arg_str,0); }
  760.     |    FUNC2x '(' sexpr csexpr cexpr ')'
  761.             { $$ = make_op($1, 3, $3, $4, $5);
  762.                 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
  763.                 fbmcompile($$[2].arg_ptr.arg_str,0); }
  764.     |    FUNC3 '(' sexpr csexpr cexpr ')'
  765.             { $$ = make_op($1, 3, $3, $4, $5); }
  766.     |    FUNC4 '(' sexpr csexpr csexpr cexpr ')'
  767.             { arg4 = $6;
  768.               $$ = make_op($1, 4, $3, $4, $5); }
  769.     |    FUNC5 '(' sexpr csexpr csexpr csexpr cexpr ')'
  770.             { arg4 = $6; arg5 = $7;
  771.               $$ = make_op($1, 5, $3, $4, $5); }
  772.     |    HSHFUN '(' hshword ')'
  773.             { $$ = make_op($1, 1,
  774.                 $3,
  775.                 Nullarg,
  776.                 Nullarg); }
  777.     |    HSHFUN hshword
  778.             { $$ = make_op($1, 1,
  779.                 $2,
  780.                 Nullarg,
  781.                 Nullarg); }
  782.     |    HSHFUN3 '(' hshword csexpr cexpr ')'
  783.             { $$ = make_op($1, 3, $3, $4, $5); }
  784.     |    bareword
  785.     |    listop
  786.     ;
  787.  
  788.  
  789. listop    :    LISTOP
  790.             { $$ = make_op($1,2,
  791.                 stab2arg(A_WORD,Nullstab),
  792.                 stab2arg(A_STAB,defstab),
  793.                 Nullarg); }
  794.     |    LISTOP expr
  795.             { $$ = make_op($1,2,
  796.                 stab2arg(A_WORD,Nullstab),
  797.                 maybelistish($1,make_list($2)),
  798.                 Nullarg); }
  799.     |    LISTOP WORD
  800.             { $$ = make_op($1,2,
  801.                 stab2arg(A_WORD,stabent($2,TRUE)),
  802.                 stab2arg(A_STAB,defstab),
  803.                 Nullarg); }
  804.     |    LISTOP WORD expr
  805.             { $$ = make_op($1,2,
  806.                 stab2arg(A_WORD,stabent($2,TRUE)),
  807.                 maybelistish($1,make_list($3)),
  808.                 Nullarg); Safefree($2); $2 = Nullch; }
  809.     |    LISTOP REG expr
  810.             { $$ = make_op($1,2,
  811.                 stab2arg(A_STAB,$2),
  812.                 maybelistish($1,make_list($3)),
  813.                 Nullarg); }
  814.     |    LISTOP block expr
  815.             { $$ = make_op($1,2,
  816.                 cmd_to_arg($2),
  817.                 maybelistish($1,make_list($3)),
  818.                 Nullarg); }
  819.     ;
  820.  
  821.  
  822. handle    :    WORD
  823.             { $$ = stab2arg(A_WORD,stabent($1,TRUE));
  824.               Safefree($1); $1 = Nullch;}
  825.     |    sexpr
  826.     ;
  827.  
  828.  
  829. aryword    :    WORD
  830.             { $$ = stab2arg(A_WORD,aadd(stabent($1,TRUE)));
  831.                 Safefree($1); $1 = Nullch; }
  832.     |    ARY
  833.             { $$ = stab2arg(A_STAB,$1); }
  834.     ;
  835.  
  836.  
  837. hshword    :    WORD
  838.             { $$ = stab2arg(A_WORD,hadd(stabent($1,TRUE)));
  839.                 Safefree($1); $1 = Nullch; }
  840.     |    HSH
  841.             { $$ = stab2arg(A_STAB,$1); }
  842.     ;
  843.  
  844.  
  845. crp    :    ',' ')'
  846.             { $$ = 1; }
  847.     |    ')'
  848.             { $$ = 0; }
  849.     ;
  850.  
  851.  
  852. /*
  853.  * NOTE:  The following entry must stay at the end of the file so that
  854.  * reduce/reduce conflicts resolve to it only if it's the only option.
  855.  */
  856.  
  857.  
  858. bareword:    WORD
  859.             { char *s;
  860.                 $$ = op_new(1);
  861.                 $$->arg_type = O_ITEM;
  862.                 $$[1].arg_type = A_SINGLE;
  863.                 $$[1].arg_ptr.arg_str = str_make($1,0);
  864.                 for (s = $1; *s && isLOWER(*s); s++) ;
  865.                 if (dowarn && !*s)
  866.                 warn(
  867.                   "\"%s\" may clash with future reserved word",
  868.                   $1 );
  869.             }
  870.         ;
  871. %% /* PROGRAM */
  872.